package Format;

use strict;

# mIRC formatting protocol constants
use constant {
	PLAIN            => chr(15),
	BOLD             => chr(2),
	ITALIC           => chr(22),
	UNDERLINE        => chr(31),
	COLOR_CODE       => chr(3),
	UN_COLOR         => chr(3) . " ",
	UN_COLOR_NOSPACE => chr(3),         # Sequence for better compatibility
	white            => '00',
	black            => '01',
	dark_blue        => '02',
	navy_blue        => '02',
	dark_green       => '03',
	red              => '04',
	brown            => '05',
	dark_red         => '05',
	purple           => '06',
	dark_yellow      => '07',
	olive            => '07',
	orange           => '07',
	yellow           => '08',
	green            => '09',
	lime             => '09',
	dark_cyan        => '10',
	teal             => '10',
	cyan             => '11',
	blue             => '12',
	royal_blue       => '12',
	magenta          => '13',
	pink             => '13',
	fuchsia          => '13',
	gray             => '14',
	light_gray       => '15',
	silver           => '15'
};

# Color names to IRC codes conversion hash
my %name2color = (
	'white',       white,       'black',      black,      'dark_blue', dark_blue,
	'navy_blue',   navy_blue,   'dark_green', dark_green, 'red',       red,
	'brows',       brown,       'dark_red',   dark_red,   'purple',    purple,
	'dark_yellow', dark_yellow, 'olive',      olive,      'orange',    orange,
	'yellow',      yellow,      'green',      green,      'lime',      lime,
	'dark_cyan',   dark_cyan,   'teal',       teal,       'cyan',      cyan,
	'blue',        blue,        'royal_blue', royal_blue, 'magenta',   magenta,
	'pink',        pink,        'fuchsia',    fuchsia,    'gray',      gray,
	'light_gray',  light_gray,  'silver',     silver
);

# IRC codes to name conversion hash
my %color2name = reverse %name2color;

sub fixcolor
{
	my $color = $_[0];
	if (length($color) < 2) {
		return '0' . $color;
	}
	return $color;
}

sub fromIRC
{
	my $text = $_[0];
	$text =~ s/</\\</g;
	$text =~ s/>/\\>/g;
	my @from = split(//, $text);
	my $to;
	my $bold = 0, my $italic = 0, my $underline = 0;
	my $color = "", my $bgcolor = "";
	while (my $char = shift @from) {

		if ($char eq BOLD) {    # Switch the bold state
			if (!$bold) {
				$to .= "<b>";
			}
			else {
				$to .= "</b>";
			}
			$bold = !$bold;
		}
		elsif ($char eq ITALIC) {    # Switch the italic state
			if (!$italic) {
				$to .= "<i>";
			}
			else {
				$to .= "</i>";
			}
			$italic = !$italic;
		}
		elsif ($char eq UNDERLINE) {    # Switch the underline state
			if (!$underline) {
				$to .= "<u>";
			}
			else {
				$to .= "</u>";
			}
			$underline = !$underline;
		}
		elsif ($char eq PLAIN) {        # Disable all states
			if ($bold) {
				$to .= "</b>";
				$bold = 0;
			}
			if ($italic) {
				$to .= "</i>";
				$italic = 0;
			}
			if ($underline) {
				$to .= "</u>";
				$underline = 0;
			}
		}
		elsif ($char eq COLOR_CODE) {    # Blah, color
			my $fgcode1 = shift @from;
			my $fgcode2 = shift @from;
			my ($bgcode1, $bgcode2);
			my $newcolor = "", my $newbgcolor = "";

			if (defined $fgcode2  and $color2name{$fgcode1 . $fgcode2}) {    # Good, color identified
				$newcolor = $color2name{$fgcode1 . $fgcode2};
			}
			elsif ($color2name{'0' . $fgcode1})
			{ # Well .. this might be enabled for better compatibility but the color code should be 2 bytes usually.
				$newcolor = $color2name{'0' . $fgcode1};
				unshift(@from, $fgcode2);
			}
			else {    # This is not a valid color code, it might be an UN_COLOR sequence
				if ($char . $fgcode1 eq UN_COLOR) {    # is it?
					unshift(@from, $fgcode2);
				}
				else {    # Seems like a broken sequence .. but it usually means UN_COLOR
					unshift(@from, $fgcode2);
					unshift(@from, $fgcode1);
				}
			}

			if ($newcolor ne "") {    # Checking bg color makes sense only if the fg color was set
				my $comma = shift @from;
				if ($comma eq ",") {    # There might be a background color after comma
					$bgcode1 = shift @from;
					$bgcode2 = shift @from;
					if (defined $bgcode2 and $color2name{$bgcode1 . $bgcode2}) {    # Check if it's a color
						$newbgcolor = $color2name{$bgcode1 . $bgcode2};
					}
					elsif ($color2name{'0' . $bgcode1})
					{ # Support broken codes. Theoretically the color code should be always 2 byte width
						$newbgcolor = $color2name{'0' . $bgcode1};
						unshift(@from, $bgcode2);
					}
					else {    # It wasn't a color after all, return the taken chars
						unshift(@from, $bgcode2);
						unshift(@from, $bgcode1);
						unshift(@from, ",");
					}
				}
				else {
					unshift(@from, $comma);
				}
			}

			if ($newcolor ne "") {    # Finally, handle the new color ...
				$color = $newcolor;
				if ($newbgcolor ne "") {
					$bgcolor = $newbgcolor;
					$to .= "<c fg=\"" . $color . "\" bg=\"" . $bgcolor . "\">";
				}
				else {
					$to .= "<c fg=\"" . $color . "\">";
				}

			}
			elsif ($color ne "") {    # If there's no new color, reset the previous one
				$to .= "</c>";
				$color = "";
			}
		}
		else {
			$to .= $char;
		}
	}

	# Now close all tags for remaining states
	if ($bold) {
		$to .= "</b>";
	}
	if ($italic) {
		$to .= "</i>";
	}
	if ($underline) {
		$to .= "</u>";
	}
	if ($color ne "") {
		$to .= "</c>";
	}

	return $to;
}

sub toIRC
{
	my $text    = $_[0];
	$text =~ s/<(\/|)b>/BOLD/eg; # replace all <b> and </b> tags into IRC bold switched
	$text =~ s/<(\/|)i>/ITALIC/eg; # .. same here for <i>
	$text =~ s/<(\/|)u>/UNDERLINE/g; # .. and here for <u>

	my @colorstack;
	# Below matches <c fg="color_name"> or <c fg="color_name" bg="color_name"> or </c>
	# extra \s+ allow additional whitespace in some places.
	$text =~ s/(?:<c\s+fg\s*=\s*\"(\w+)\"(?:|\s+bg\s*=\s*\"(\w+)\")\s*>|<\/c\s*>)/
	my $ret;
	if($1) { # <c> opening
	    $ret = COLOR_CODE . $name2color{$1};
	    if($2) { # also include background color
		$ret .= "," . $name2color{$2};
	    }
	    push(@colorstack, $ret);
	}
	else { # <c> closing
	    if(@colorstack > 1) {
		pop (@colorstack);
		$ret = $colorstack[$#colorstack]; # set the previous color
	    }
	    else {
		pop(@colorstack);
		$ret = UN_COLOR; # no previous color, disable all together
	    }
	}
	$ret;
    /egx; # The above code iterates over all <c> and </c> tags in the given text
    # and converts them into appropriate IRC codes. The @colorstack is needed
    # for nested tags, since IRC formatting is a simple state machine.

	return $text;
}

sub bold
{
	return "<b>" . $_[0] . "</b>";
}

sub italic
{
	return "<i>" . $_[0] . "</i>";
}

sub underline
{
	return "<u>" . $_[0] . "</u>";
}

sub color
{
	my $ret;
	if(defined $_[1] and $name2color{$_[1]}) {
	    $ret .= "<c fg=\"" . $_[1] ."\"";
	}
	elsif(defined $_[1] and my $c = $color2name{fixcolor($_[1])}) {
	    $ret .= "<c fg=\"" . $c ."\"";
	}
	else {
	    return $_[0];
	}
	if(defined $_[2] and $name2color{$_[2]}) {
	    $ret .= " bg=\"" . $_ [2]. "\"";
	}
	elsif(defined $_[2] and my $c = $color2name{fixcolor($_[2])}) {
	    $ret .= " bg=\"" . $c. "\"";
	}
	return $ret . ">" . $_[0] . "</c>";
}
1;
